home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbactcmd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  10.1 KB  |  296 lines
  1. (*===========================================================================*)
  2. (* Activity command                                                          *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1991 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. {$O+}
  9.  
  10. UNIT BBACTCMD;
  11.  
  12. INTERFACE
  13.  
  14. PROCEDURE activity_cmd(cmd_string : STRING);
  15.  
  16. IMPLEMENTATION
  17.  
  18.   USES
  19.     bbdummy,
  20.     bbmdata,
  21.     bbmess,
  22.     bbmisc,
  23.     bbsdata,
  24.     bbstr;
  25.  
  26. PROCEDURE list_ports;         FORWARD;
  27. PROCEDURE list_current_users; FORWARD;
  28.  
  29. (*===========================================================================*)
  30. (* Activity command                                                          *)
  31. (*      Entered when 'J' received by command processor                       *)
  32. (*===========================================================================*)
  33.  
  34. PROCEDURE activity_cmd(cmd_string : STRING);
  35.  
  36.   VAR
  37.     c     : CHAR;
  38.     found : BOOLEAN;
  39.     i     : WORD;
  40.     p_ptr : port_block_ptr;
  41.     s_ptr : port_block_ptr;
  42.     t_str : STRING;
  43.  
  44.   BEGIN;
  45.  
  46.     (*-----------------------------------------------------------------------*)
  47.     (* Must be simple command                                                *)
  48.     (*-----------------------------------------------------------------------*)
  49.  
  50.     IF WORDS(cmd_string) > 1 THEN
  51.       BEGIN;
  52.         send_message(message_err_wrd);
  53.         active_tcb^.error_sw := TRUE;
  54.         EXIT;
  55.       END;
  56.  
  57.     (*-----------------------------------------------------------------------*)
  58.     (* Handle one letter command                                             *)
  59.     (*-----------------------------------------------------------------------*)
  60.  
  61.     IF LENGTH(cmd_string) = 1 THEN
  62.       BEGIN;
  63.         list_ports;
  64.         EXIT;
  65.       END;
  66.  
  67.     (*-----------------------------------------------------------------------*)
  68.     (* Get second letter of command                                          *)
  69.     (*-----------------------------------------------------------------------*)
  70.  
  71.     c := UPCASE(cmd_string[2]);
  72.  
  73.     (*-----------------------------------------------------------------------*)
  74.     (* Handle list current users                                             *)
  75.     (*-----------------------------------------------------------------------*)
  76.  
  77.     IF c = 'N' THEN
  78.       BEGIN;
  79.         list_current_users;
  80.         EXIT;
  81.       END;
  82.  
  83.     (*-----------------------------------------------------------------------*)
  84.     (* Find port                                                             *)
  85.     (*-----------------------------------------------------------------------*)
  86.  
  87.     IF c = 'L' THEN
  88.       p_ptr := @dummy_port
  89.     ELSE
  90.       BEGIN;
  91.  
  92.         s_ptr := active_port;
  93.  
  94.         IF find_port(c) THEN
  95.           p_ptr := active_port
  96.         ELSE
  97.           p_ptr := NIL;
  98.  
  99.         active_port          := s_ptr;
  100.         active_tcb^.tcb_port := s_ptr;
  101.  
  102.         IF p_ptr = NIL THEN
  103.           BEGIN;
  104.             send_message(message_err_2nd);
  105.             active_tcb^.error_sw := TRUE;
  106.             EXIT;
  107.           END;
  108.  
  109.       END;
  110.  
  111.     (*-----------------------------------------------------------------------*)
  112.     (* List the data                                                         *)
  113.     (*-----------------------------------------------------------------------*)
  114.  
  115.     found := FALSE;
  116.  
  117.     FOR i := 1 TO opt_block.n_mon DO
  118.       WITH p_ptr^.call_list^[i] DO
  119.         IF port_call_sign <> '' THEN
  120.           BEGIN;
  121.             c := port_call_port;
  122.             IF c < 'A' THEN
  123.               c := CHR(ORD(c) + ORD('A'));
  124.             send_tnc_data_str(LEFT(port_call_sign, SIZEOF(port_call_sign))
  125.                                              + c + ' ' + port_call_date + cr);
  126.             found := TRUE;
  127.           END;
  128.  
  129.     (*-----------------------------------------------------------------------*)
  130.     (* Nothing found?                                                        *)
  131.     (*-----------------------------------------------------------------------*)
  132.  
  133.     IF NOT found THEN
  134.        send_message(message_jn_no_users);
  135.  
  136.   END;
  137.  
  138. (*===========================================================================*)
  139. (* Provides a list of ports                                                  *)
  140. (*===========================================================================*)
  141.  
  142. PROCEDURE list_ports;
  143.  
  144.   VAR
  145.     p_ptr : port_block_ptr;
  146.  
  147.   BEGIN;
  148.  
  149.     p_ptr := ring_port;
  150.  
  151.     REPEAT
  152.       WITH p_ptr^ DO
  153.         BEGIN;
  154.           send_tnc_data_str('J' + port_char + ' - ' + port_name + cr);
  155.           p_ptr := next_port;
  156.         END;
  157.     UNTIL p_ptr = ring_port;
  158.  
  159.     send_message(message_j_list_end);
  160.  
  161.   END;
  162.  
  163. (*===========================================================================*)
  164. (* Provides a list of current users                                          *)
  165. (*   Code contributed by NQ1C                                                *)
  166. (*===========================================================================*)
  167.  
  168. PROCEDURE list_current_users;
  169.  
  170.   VAR
  171.     t_str    : STRING[150];
  172.     w_tcb    : tcb_ptr;
  173.     found    : BOOLEAN;
  174.  
  175.   BEGIN;
  176.  
  177.     (*-----------------------------------------------------------------------*)
  178.     (* Initialize threads                                                    *)
  179.     (*-----------------------------------------------------------------------*)
  180.  
  181.     w_tcb := ring_tcb;
  182.  
  183.     found := FALSE;
  184.  
  185.     (*-----------------------------------------------------------------------*)
  186.     (* Loop for all threads                                                  *)
  187.     (*-----------------------------------------------------------------------*)
  188.  
  189.     REPEAT
  190.  
  191.       WITH w_tcb^ DO
  192.         BEGIN;
  193.  
  194.           (*-----------------------------------------------------------------*)
  195.           (* Make sure it has a name                                         *)
  196.           (*-----------------------------------------------------------------*)
  197.  
  198.           IF tcb_name <> '' THEN
  199.             BEGIN;
  200.  
  201.               (*-------------------------------------------------------------*)
  202.               (* yes.. We found something to tell about                      *)
  203.               (*-------------------------------------------------------------*)
  204.  
  205.               found := TRUE;
  206.  
  207.               (*-------------------------------------------------------------*)
  208.               (* Put the job name and user info in the line                  *)
  209.               (*-------------------------------------------------------------*)
  210.  
  211.               t_str := port_chan_s + ' ' + tcb_name + ' ';
  212.  
  213.               (*-------------------------------------------------------------*)
  214.               (* If there is name, display it                                *)
  215.               (*-------------------------------------------------------------*)
  216.  
  217.               IF (uid_data.user_name <> '?') AND (uid_data.user_name <> '') THEN
  218.                 t_str := t_str + '[' + uid_data.user_name + '] ';
  219.  
  220.               (*-------------------------------------------------------------*)
  221.               (* Get description of task                                     *)
  222.               (*-------------------------------------------------------------*)
  223.  
  224.               CASE tcb_type OF
  225.  
  226.                 th_fwd_slave :
  227.                   BEGIN;
  228.                     t_str := t_str + get_message(message_jn_out_fwd);
  229.                     IF NOT tcb_abbs THEN
  230.                       t_str := t_str + get_message(message_jn_cip);
  231.                   END;
  232.  
  233.                 th_user :
  234.                   BEGIN;
  235.  
  236.                      (*-----------------------------------------------------*)
  237.                      (* BBS connected?                                      *)
  238.                      (*-----------------------------------------------------*)
  239.  
  240.                      IF tcb_abbs THEN
  241.                        t_str := t_str + get_message(message_jn_in_fwd);
  242.  
  243.                      (*-----------------------------------------------------*)
  244.                      (* Operator talking to him?                            *)
  245.                      (*-----------------------------------------------------*)
  246.  
  247.                      IF tcb_opr_talk THEN
  248.                        t_str := t_str + get_message(message_jn_t_sysop);
  249.  
  250.                    END;
  251.  
  252.                  th_opr_terminal, th_answer:
  253.  
  254.                    t_str := t_str + get_message(message_jn_st);
  255.  
  256.                  ELSE
  257.                    ;
  258.  
  259.               END; (*----- End case statement -------------------------------*)
  260.  
  261.               (*-------------------------------------------------------------*)
  262.               (* Reverse forward?                                            *)
  263.               (*-------------------------------------------------------------*)
  264.  
  265.               IF tcb_rev_fwd THEN
  266.                 t_str := t_str + get_message(message_jn_r_fwd);
  267.  
  268.               (*-------------------------------------------------------------*)
  269.               (* Send the data                                               *)
  270.               (*-------------------------------------------------------------*)
  271.  
  272.               send_tnc_data_str(t_str + cr);
  273.  
  274.             END;
  275.  
  276.           (*-----------------------------------------------------------------*)
  277.           (* Chain to next thread                                            *)
  278.           (*-----------------------------------------------------------------*)
  279.  
  280.           w_tcb := w_tcb^.next_tcb;
  281.  
  282.         END;
  283.  
  284.     UNTIL w_tcb = ring_tcb; (*----- End loop thru all threads ---------------*)
  285.  
  286.     (*-----------------------------------------------------------------------*)
  287.     (* Nothing found                                                         *)
  288.     (*-----------------------------------------------------------------------*)
  289.  
  290.     IF NOT found THEN
  291.        send_message(message_jn_no_users);
  292.  
  293.   END;
  294.  
  295. END.
  296.